home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / rx.mod (.txt) < prev    next >
Oberon Text  |  1995-10-30  |  12KB  |  371 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. MODULE RX;    (* Andreas Margelisch, 1990 *)
  4. IMPORT RXA, Oberon, Texts, Viewers, MenuViewers, TextFrames, Display;
  5. CONST 
  6.     blank = 32; (* blank *)
  7.     tab = 9; (* tab *)
  8.     cr = 13; (* carriage return *)
  9.     dq = 34; (* double quotes *)
  10.     noerror = 0;
  11.     strtoolong = -1;
  12.     linetoolong = -2;
  13.     (* nofline = 32000; *) nofline = 20000;
  14.     (* nofrepl = 32000; *) nofrepl = 20000;
  15.     w: Texts.Writer;
  16.     sbeg, send, errorvar : INTEGER;
  17.     sdfa : RXA.DFA;
  18.     stext : Texts.Text;
  19.     stextpos, slinelen : LONGINT;
  20.     sline : ARRAY(nofline+1) OF CHAR;
  21.     sreplaced, casesens, replset : BOOLEAN;
  22.     replstr : ARRAY(nofrepl+1) OF CHAR;
  23.     ch : CHAR;
  24. PROCEDURE Focus():TextFrames.Frame;
  25.     VAR f : Display.Frame;
  26. BEGIN
  27.     IF Oberon.FocusViewer.state > 1 THEN
  28.         f := Oberon.FocusViewer.dsc;
  29.         IF ( f # NIL ) & ( f.next # NIL ) & ( f.next IS TextFrames.Frame ) THEN RETURN f.next( TextFrames.Frame ) END;
  30.     END;
  31.     RETURN NIL
  32. END Focus;
  33. PROCEDURE MyCAP( ch : CHAR ) : CHAR;
  34. BEGIN IF ("a" <= ch ) & ( ch <= "z" ) THEN RETURN CAP( ch ) ELSE RETURN ch END;
  35. END MyCAP;
  36. PROCEDURE GetText(  VAR text : Texts.Text; VAR name : ARRAY OF CHAR; VAR s : Texts.Scanner );
  37.          f : Display.Frame;
  38.          ss : Texts.Scanner;
  39.          v : Viewers.Viewer;
  40. BEGIN
  41.     Texts.Scan( s );
  42.     text := NIL; name[0] := 0X;
  43.     IF s.class = Texts.Name THEN
  44.         NEW( text ); Texts.Open( text, s.s ); COPY( s.s, name );
  45.     ELSIF ( s.class = Texts.Char ) & ( s.c = "*" ) THEN
  46.         v := Oberon.MarkedViewer();            
  47.         f := v.dsc;
  48.         IF ( v.state > 1 ) & ( f # NIL ) & ( f.next # NIL ) & ( f.next IS TextFrames.Frame ) THEN
  49.             IF ( f IS TextFrames.Frame ) THEN
  50.                 Texts.OpenScanner( ss, f(TextFrames.Frame ).text, 0 ); Texts.Scan( ss );
  51.                 IF ss.class = Texts.Name THEN COPY ( ss.s, name) END;
  52.             END; 
  53.             text := f.next( TextFrames.Frame ).text;
  54.         END; 
  55.     END; 
  56. END GetText;
  57. PROCEDURE GetOption( VAR reader : Texts.Reader; VAR opti : BOOLEAN );
  58. BEGIN
  59.     casesens := TRUE;
  60.     opti := FALSE;
  61.     Texts.Read( reader, ch );    
  62.     WHILE ( ORD(ch) = tab ) OR ( ORD(ch) = blank ) OR ( ORD(ch) = cr ) DO Texts.Read( reader, ch ) END;
  63.     IF  ch = "\" THEN
  64.         REPEAT
  65.             Texts.Read( reader, ch );
  66.             CASE ch OF
  67.                 "c"  : casesens := ~casesens |
  68.                 "i" : opti := ~opti |
  69.                 "~" : RETURN;
  70.             ELSE
  71.             END; 
  72.         UNTIL ( ORD(ch) = blank ) OR ( ORD(ch) = cr ) OR ( ORD(ch) =tab );
  73.     END; 
  74. END GetOption;
  75. PROCEDURE GetStr( VAR reader : Texts.Reader; VAR str : ARRAY OF CHAR );
  76.     VAR strfull, inquotes, first : BOOLEAN;
  77.         strind : INTEGER;
  78.     PROCEDURE Append( chr : CHAR );
  79.     BEGIN
  80.         IF strind < LEN( str ) THEN str[strind] := chr; INC(strind) ELSE strfull := TRUE END;
  81.     END Append;
  82. BEGIN
  83.     strfull := FALSE; strind := 0; inquotes := FALSE; first := FALSE;
  84.     WHILE ( ORD(ch) = tab ) OR ( ORD(ch) = cr ) OR ( ORD(ch) = blank ) DO Texts.Read( reader, ch ) END;
  85.     WHILE ( ~reader.eot ) & ( ORD(ch) # cr ) DO
  86.         IF ~first & ( ORD(ch) = dq ) THEN inquotes := ~inquotes; first := inquotes; Append( ch );
  87.         ELSE
  88.             IF inquotes & ~casesens THEN Append( MyCAP( ch ) ) ELSE Append( ch ) END;
  89.             first := FALSE;
  90.         END;
  91.         Texts.Read( reader, ch );
  92.     END;
  93.     Append( CHR(0) );
  94.     IF strfull THEN errorvar := strtoolong END;
  95. END GetStr;
  96. PROCEDURE RXAErrorHandler( error, pos : INTEGER );
  97. BEGIN
  98.     CASE error OF
  99.         RXA.noposfree : Texts.WriteString( w,"regular expression too long ( position table full )") |
  100.         RXA.nostatesfree : Texts.WriteString( w,"regular expression too long ( state table full  )") |
  101.         RXA.nometaexp : Texts.WriteString( w,"no metasymbol at pos "); Texts.WriteInt( w, pos, 3 );
  102.                                   Texts.WriteString( w," expected ") |
  103.         RXA.chrleft : Texts.WriteString( w,"regular expression not correct ( ')', ']' or '}' on a wrong place )") |
  104.         RXA.wsubexpr : Texts.WriteString( w,"subexpression, String or shorthands 't' or 'c' at pos "); Texts.WriteInt( w,pos, 3);
  105.                                    Texts.WriteString( w," expected ") |
  106.         RXA.subexprrest : Texts.WriteString( w,"marked subexpression at pos "); Texts.WriteInt( w,pos, 3); 
  107.                                       Texts.WriteString( w," shouldn't be enclosed by '{  }'  ") |
  108.         RXA.wshorthand : Texts.WriteString( w,"wrong shorthand identifier at pos "); Texts.WriteInt( w,pos, 3); Texts.WriteLn( w );
  109.                                       Texts.WriteString( w,"permitted are : A, a, b, c, d, h, i, l, o, t, w ") |
  110.         RXA.nodfa : Texts.WriteString( w,"replace faild : automata is missing") |
  111.         RXA.repllinefull : Texts.WriteString( w,"replace faild : replacestring is full ") |
  112.         RXA.notnotexp : Texts.WriteString( w,"metasymbol or more than one literal in qutoes after notoperator") |
  113.         RXA.linecopofl : Texts.WriteString( w, "array linecop in RXA.Replace is too small");
  114.     ELSE
  115.         Texts.Write(w, "'"); Texts.Write(w, CHR(error)); Texts.Write(w, "'"); Texts.WriteString( w," at pos ");
  116.         Texts.WriteInt( w,pos, 3); Texts.WriteString( w," expected ");
  117.     END; 
  118.     Texts.WriteLn( w );
  119.     Texts.Append( Oberon.Log, w.buf);
  120. END RXAErrorHandler;
  121. PROCEDURE RXErrorHandler( text : ARRAY OF CHAR );
  122. BEGIN
  123.     CASE errorvar OF
  124.         strtoolong, linetoolong : Texts.WriteString( w, text ); Texts.WriteString( w," too long "); |
  125.     ELSE
  126.         Texts.WriteString( w, text );
  127.     END; 
  128.     Texts.WriteLn( w );
  129.     Texts.Append( Oberon.Log, w.buf);
  130.     errorvar := noerror;
  131. END RXErrorHandler;
  132. PROCEDURE ParseTexts( text : Texts.Text; name : ARRAY OF CHAR; dfa : RXA.DFA; opti : BOOLEAN );
  133.     VAR 
  134.         ch : CHAR;
  135.         r : Texts.Reader;
  136.         line, linec : ARRAY(nofline+1) OF CHAR;
  137.         lineind, i, beg, end : INTEGER;
  138.         wtext: Texts.Text;
  139.         x, y: INTEGER;
  140.         v: Viewers.Viewer;
  141.         linefull : BOOLEAN;
  142.     PROCEDURE Append( chr : CHAR );
  143.     BEGIN
  144.         IF lineind < LEN( line ) THEN line[lineind] := chr; INC(lineind) ELSE linefull := TRUE END; 
  145.     END Append;
  146. BEGIN
  147.     Oberon.AllocateUserViewer( Oberon.Mouse.X, x, y );
  148.     wtext := TextFrames.Text("");
  149.     v := MenuViewers.New(TextFrames.NewMenu("RX.Grep", "System.Close  System.Copy  System.Grow"), 
  150.                 TextFrames.NewText(wtext, 0), TextFrames.menuH, x, y);
  151.     Texts.OpenReader( r, text, 0 );
  152.     WHILE ( ~ r.eot ) DO
  153.         lineind := 0; linefull := FALSE;
  154.         REPEAT
  155.             Texts.Read( r, ch ); Append( ch );
  156.         UNTIL  r.eot OR ( ch = CHR(cr) );
  157.         Append( CHR(0) );
  158.         IF linefull THEN
  159.             RXErrorHandler( " ERROR : line is too long ");
  160.         ELSE
  161.             beg := 0;
  162.             IF casesens THEN
  163.                 RXA.Search( dfa, line, beg, end );
  164.             ELSE
  165.                 COPY( line, linec ); i := 0; ch := linec[0];
  166.                 WHILE ch # 0X DO linec[i] := MyCAP( ch ); INC(i); ch := linec[i] END;
  167.                 RXA.Search( dfa, linec, beg, end );
  168.             END; 
  169.             IF ( ( end >= 0 ) & (~opti) ) OR ( ( end < 0 ) & opti ) THEN
  170.                 i := 0; WHILE i < lineind-1 DO Texts.Write(w, line[i] ); INC(i) END;
  171.                 Texts.Append( wtext, w.buf );
  172.             END; 
  173.         END; 
  174.     END; 
  175. END ParseTexts;
  176. PROCEDURE Grep*;
  177.     VAR 
  178.         opti : BOOLEAN;
  179.         rx : ARRAY(nofline+1) OF CHAR;
  180.         error, erpos : INTEGER;
  181.         dfa : RXA.DFA;
  182.         s : Texts.Scanner;
  183.         text : Texts.Text;
  184.         name : ARRAY 32 OF CHAR;
  185. BEGIN
  186.     Oberon.Collect(0);
  187.     Texts.OpenScanner( s, Oberon.Par.text, Oberon.Par.pos );
  188.     GetText( text, name, s );
  189.     GetOption( s, opti );
  190.     GetStr( s, rx );
  191.     IF errorvar = noerror THEN
  192.         RXA.New( rx, dfa, error, erpos );
  193.         IF (error = RXA.noerror) & ( text # NIL ) THEN 
  194.             ParseTexts( text, name, dfa, opti ) 
  195.         ELSE 
  196.             RXAErrorHandler( error, erpos )
  197.         END;
  198.     ELSE
  199.         RXErrorHandler("regular expression");
  200.     END; 
  201. END Grep;
  202. PROCEDURE SetSearch*;
  203.     VAR 
  204.         opti : BOOLEAN;
  205.         rx : ARRAY(nofline+1) OF CHAR;
  206.         ind : INTEGER;
  207.         error, erpos : INTEGER;
  208.         r : Texts.Reader;
  209. BEGIN
  210.     Oberon.Collect(0);
  211.     Texts.OpenReader( r, Oberon.Par.text, Oberon.Par.pos );        
  212.     GetOption( r, opti );
  213.     GetStr( r, rx );
  214.     IF errorvar = noerror THEN
  215.         RXA.New( rx, sdfa, error, erpos );
  216.         IF error # RXA.noerror THEN RXAErrorHandler( error, erpos ) END;
  217.     ELSE
  218.         RXErrorHandler("regular expression");
  219.     END; 
  220. (*    RXA.Dump( sdfa, w ); Texts.Append( Oberon.Log, w.buf ); *)
  221. END SetSearch;
  222. PROCEDURE SetReplace*;
  223.     VAR r : Texts.Reader;
  224. BEGIN
  225.     replset := TRUE;
  226.     Texts.OpenReader( r, Oberon.Par.text, Oberon.Par.pos );
  227.     Texts.Read(r, ch);    (* << mmb *)
  228.     GetStr( r, replstr );
  229.     IF errorvar # noerror THEN RXErrorHandler("replace pattern"); END;
  230. END SetReplace;
  231. PROCEDURE SearchPattern( text : Texts.Text; textpos : LONGINT );
  232.     VAR 
  233.     r : Texts.Reader;
  234.     beg, end, lineind : INTEGER;
  235.     ch : CHAR;
  236.     line : ARRAY(nofline+1) OF CHAR;
  237.     linelen : LONGINT;
  238.     linefull : BOOLEAN;
  239. PROCEDURE Append( chr : CHAR );
  240. BEGIN
  241.     IF lineind < LEN( line ) THEN 
  242.         IF ~casesens  THEN line[lineind] := MyCAP( chr ) ELSE line[lineind] := chr END;
  243.         INC(lineind);
  244.     ELSE
  245.         linefull := TRUE;
  246.     END; 
  247. END Append;
  248. BEGIN
  249.     end := -1;
  250.     Texts.OpenReader( r, text, textpos );
  251.     WHILE  ( ~ r.eot ) & ( end < 0 ) DO
  252.         lineind := 0; linefull := FALSE;
  253.         textpos := Texts.Pos( r );
  254.         REPEAT
  255.             Texts.Read( r, ch );
  256.             Append( ch );
  257.         UNTIL r.eot OR ( ch = CHR(cr) );
  258.         linelen := lineind;
  259.         Append( CHR(0) );
  260.         IF linefull THEN
  261.             RXErrorHandler( " ERROR : line is too long ");
  262.         ELSE
  263.             beg := 0;
  264.             RXA.Search( sdfa, line, beg, end ); 
  265.         END; 
  266.     END; 
  267.     IF end >= 0 THEN
  268.         stext := text; stextpos := textpos; slinelen := linelen; sbeg := beg; send := end; sreplaced := FALSE; COPY( line, sline );
  269.     END; 
  270. END SearchPattern;
  271. PROCEDURE Search*;
  272.     VAR 
  273.         frame : TextFrames.Frame;
  274.         textpos : LONGINT;
  275. BEGIN
  276.     errorvar := noerror;
  277.     frame := Focus();
  278.     IF frame # NIL THEN
  279.         IF frame.hasCar THEN textpos := frame.carloc.pos ELSE textpos := 0 END;
  280.         SearchPattern( frame.text, textpos );
  281.         IF ( ~sreplaced ) & ( frame.text = stext ) THEN
  282.             Oberon.RemoveMarks( frame.X, frame.Y, frame.W, frame.H );
  283.             TextFrames.RemoveSelection( frame );
  284.             TextFrames.RemoveCaret( frame );
  285.             IF stextpos + send > TextFrames.Pos( frame, frame.X + frame.W, frame.Y  ) THEN
  286.                 TextFrames.Show( frame, stextpos + send-200 );
  287.             END; 
  288.             TextFrames.SetSelection( frame, stextpos + sbeg, stextpos + send  );
  289.             TextFrames.SetCaret( frame, stextpos + send );
  290.         END
  291.     END; 
  292. END Search;
  293. PROCEDURE Replace*;
  294.     VAR 
  295.         error, pos, i : INTEGER;
  296.         frame : TextFrames.Frame;
  297.         textpos : LONGINT;
  298. BEGIN
  299.     IF ( ~sreplaced ) & replset THEN
  300.         frame := Focus();
  301.         IF frame # NIL THEN
  302.             IF  frame.hasCar & ( frame.carloc.pos = stextpos + send ) THEN
  303.                 RXA.Replace( sdfa, sline, replstr, sbeg, send, error, pos );
  304.                 sreplaced := error = RXA.noerror;
  305.                 IF sreplaced THEN
  306.                     Oberon.RemoveMarks( frame.X, frame.Y, frame.W, frame.H );
  307.                     TextFrames.RemoveSelection( frame );
  308.                     TextFrames.RemoveCaret( frame );
  309.                     Texts.Delete( frame.text, stextpos,  stextpos + slinelen );
  310.                     i := 0; WHILE( i < LEN( sline ) ) & ( sline[i] # 0X ) DO Texts.Write( w, sline[i] ); INC(i) END; 
  311.                     Texts.Insert( frame.text, stextpos, w.buf );
  312.                     textpos := stextpos + pos;
  313.                     SearchPattern( frame.text, textpos );
  314.                     IF ~sreplaced THEN
  315.                         IF stextpos + send > TextFrames.Pos( frame, frame.X + frame.W, frame.Y  ) THEN
  316.                             TextFrames.Show( frame, stextpos + send-200 );
  317.                         END;
  318.                         TextFrames.SetSelection( frame, stextpos + sbeg, stextpos + send );
  319.                         TextFrames.SetCaret( frame, stextpos + send );
  320.                     ELSE
  321.                         IF frame.org # textpos - 200 THEN TextFrames.Show( frame, textpos-200 ) END;
  322.                         TextFrames.SetCaret( frame, textpos );
  323.                     END;
  324.                 ELSE
  325.                     RXAErrorHandler( error, pos );
  326.                 END;
  327.             END
  328.         END; 
  329.     END; 
  330. END Replace;
  331. PROCEDURE ReplaceAll*;
  332.     VAR 
  333.         frame : TextFrames.Frame;
  334.         textpos : LONGINT;
  335.         error, pos, i : INTEGER;
  336. BEGIN
  337.     errorvar := noerror;
  338.     frame := Focus();
  339.     IF ( frame # NIL ) & replset THEN
  340.         IF frame.hasCar THEN textpos := frame.carloc.pos ELSE textpos := 0 END;
  341.         Oberon.RemoveMarks( frame.X, frame.Y, frame.W, frame.H );
  342.         TextFrames.RemoveSelection( frame );
  343.         TextFrames.RemoveCaret( frame );
  344.         LOOP
  345.             SearchPattern( frame.text, textpos );
  346.             IF ~sreplaced THEN
  347.                 RXA.Replace( sdfa, sline, replstr, sbeg, send, error, pos );
  348.                 IF error = RXA.noerror THEN
  349.                     sreplaced := TRUE;
  350.                     Texts.Delete( frame.text, stextpos,  stextpos + slinelen );
  351.                     i := 0; WHILE( i < LEN( sline ) ) & ( sline[i] # 0X ) DO Texts.Write( w, sline[i] ); INC(i) END; 
  352.                     Texts.Insert( frame.text, stextpos, w.buf );
  353.                     textpos := stextpos + pos;
  354.                 ELSE
  355.                     RXAErrorHandler( error, pos );
  356.                     RETURN
  357.                 END; 
  358.             ELSE
  359.                 EXIT;
  360.             END; 
  361.         END
  362.     END; 
  363. END ReplaceAll;
  364. BEGIN
  365.     Texts.OpenWriter( w );
  366.     errorvar := noerror;
  367.     replset := FALSE;
  368.     sreplaced := TRUE;
  369.     sdfa := NIL;
  370. END RX.
  371.